home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / debug / log.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  7.1 KB  |  226 lines
  1. signature LOG =
  2. sig
  3.   (* Characterizes a log with entries of type entry. *)
  4.   type entry
  5.   type mark
  6.   exception Log
  7.       (* Raised by any marker operation given a marker that is invalid
  8.          either because it points to end of log or because it points to
  9.      an entry that was truncated. *) 
  10.   val new: unit -> mark
  11.       (* Returns mark at end of new, initially empty log. *)
  12.   val copyMark: mark -> mark
  13.       (* Create a new mark that copies argument. *)
  14.   val resetMark: mark -> mark -> unit
  15.       (* Reset first arg to second. *)
  16.   val equalMarks: mark * mark -> bool
  17.       (* Returns true iff marks point to same location in same log. *)
  18.   val append: mark -> entry -> unit
  19.       (* Append to log at mark and advance mark. 
  20.          If mark is not already at end of log, truncate first. *)
  21.   val truncate: mark -> unit
  22.       (* Delete all entries in log from mark onwards. 
  23.          Invalidates marks beyond current location. 
  24.      Argument mark is still valid for appends. *)
  25.   val get: mark -> entry
  26.       (* Get entry at mark, and advance mark.
  27.          Raise Log if at end. *)
  28.   val read: mark -> entry
  29.       (* Get entry at mark, without advancing.
  30.          Raise Log if at end. *)
  31.   val replace: mark -> entry -> unit
  32.       (* Replace entry at mark, and advance mark.
  33.          Raise Log if at end. *)
  34.   val write: mark -> entry -> unit
  35.       (* Replace entry at mark, without advancing.
  36.          Raise Log if at end. *)
  37.   val advance: mark -> unit
  38.       (* Advance mark. Raise Log if at end. *)
  39. end
  40.  
  41. functor Log (type entry): LOG =
  42. struct
  43.   open Array List
  44.   infix 9 sub
  45.   type entry = entry
  46.   datatype segment = SEG of contents ref
  47.   and contents = ARRSEG of (entry array * segment (* next *))
  48.                | LISTSEG of entry list ref * int ref (* count *)
  49.   datatype mark = MARK of (segment ref (* pointer's seg *)
  50.                * int ref (* pointer's index *))
  51.   val zeroarr:entry array = arrayoflist []
  52.   exception Log
  53.   exception InLog of string
  54.  
  55. (* Note: It is not an invariant that arrays are length > 0, but we try to
  56.    avoid creating such arrays unnecessarily. *)
  57.  
  58.   fun emptyseg() = SEG(ref(LISTSEG(ref(nil:entry list),ref 0)))
  59.   fun new () = MARK(ref(emptyseg()),ref 0)
  60.  
  61.   fun normalize(SEG(contentsref as (ref(LISTSEG(ref (h::t),ref c))))) =
  62.       (* non-empty top list: convert to array *)
  63.       let val a = array(c,h)
  64.           fun fill (~1,nil) = ()
  65.         | fill(_,nil) = raise (InLog "normalize")
  66.         | fill(n,h::t) = (update(a,n,h);fill(n-1,t))
  67.       in fill(c-2,t);
  68.      contentsref := ARRSEG(a,emptyseg())
  69.       end
  70.     | normalize(SEG(ref(LISTSEG(ref nil,_)))) = () 
  71.       (* empty top list already *)
  72.     | normalize _ = () 
  73.  
  74.   fun fix(mark as (MARK(segref as (ref(SEG(ref(ARRSEG(a,next))))),indexref as ref index))) =
  75.       let fun nonempty(seg as (SEG(ref(ARRSEG(a,next))))) =
  76.            if Array.length a = 0 then
  77.          nonempty next
  78.            else seg
  79.         | nonempty(seg as (SEG(ref(LISTSEG _)))) =
  80.            seg
  81.       in segref := nonempty next;
  82.      indexref := 0
  83.       end
  84.     | fix _ = raise (InLog "fix")
  85.  
  86. (* Careful: we must take care that after a truncation, any further appends will
  87.             go into a new segment.  *)
  88.   fun truncate(MARK(ref(SEG(contentsref as (ref(LISTSEG(lref as ref l,_))))),ref index)) =
  89.       (* make an array consisting of first index elements of list. *)
  90.       let val a = if index > 0 then
  91.                 let val a = array(index,hd l) handle Hd => raise Log
  92.             fun fill (~1,_) = ()
  93.               | fill (_,nil) = raise Log (* mark was invalid *)
  94.               | fill (n,h::t) = (update(a,n,h); fill(n-1,t))
  95.             in fill (index-2,tl l);
  96.                a
  97.             end
  98.           else zeroarr
  99.           val empty = emptyseg()
  100.       in contentsref := ARRSEG(a,empty)
  101.       end
  102.     | truncate(MARK(ref(SEG(contentsref as (ref(ARRSEG(a,next))))),ref index)) =
  103.       (* mark is in intermediate ARRAYSEG. *)
  104.       let fun zap (SEG(contentsref as (ref(ARRSEG(a,next))))) =
  105.            (contentsref := LISTSEG(ref nil,ref ~1);
  106.         zap next)
  107.         | zap (SEG(contentsref as (ref(LISTSEG(lref,cref))))) =
  108.             (lref := nil;
  109.          cref := ~1)
  110.       val a' = if index > 0 then 
  111.                  array(index,a sub 0) handle Subscript => raise Log
  112.            else zeroarr
  113.       fun fill n = if n < index then
  114.                  (update(a',n,a sub n handle Subscript => raise Log);
  115.               fill (n+1))
  116.                 else ()
  117.           val empty = emptyseg()
  118.       in fill 1;
  119.          contentsref := ARRSEG(a',empty);
  120.          zap next
  121.       end
  122.  
  123.   fun append(mark as MARK(ref(SEG(ref(LISTSEG(lref as ref l,cref as ref c)))),
  124.                 indexref as ref index)) x =
  125.     if index = c then
  126.       (lref := x::l;
  127.        inc cref;
  128.        inc indexref)
  129.     else if index < c then
  130.       (truncate mark;
  131.        append mark x)
  132.     else 
  133.           raise Log
  134.     | append(mark as MARK((ref(SEG(ref(ARRSEG(a,_))))),ref index)) x =
  135.     let val alen = Array.length a
  136.     in if index = alen then
  137.          (fix mark;
  138.           append mark x)
  139.        else if index < alen then 
  140.          (* mark points into a non-zero array segment *)
  141.          (truncate mark;
  142.           append mark x)
  143.        else (* index > alen : invalid mark *)
  144.          raise Log
  145.         end
  146.  
  147.   fun copyMark(mark as MARK(segref as ref seg,indexref)) = 
  148.       (normalize seg;
  149.        MARK(ref (!segref),ref (!indexref)))
  150.  
  151.   fun resetMark (MARK(segref,indexref)) (MARK(ref seg,ref index)) =
  152.       (segref := seg;
  153.        indexref := index)
  154.  
  155.   fun read(MARK(ref(SEG(ref(LISTSEG(ref nil,_)))),_)) =
  156.       (* mark is at end of log. *)
  157.          raise Log
  158.     | read(mark as MARK(ref(seg as SEG(ref(LISTSEG _))),_)) =
  159.       (* mark is in non-empty top LISTSEG; normalize first *)
  160.         (normalize seg;
  161.      read mark)
  162.     | read(mark as MARK(ref(SEG(ref(ARRSEG(a,_)))),ref index)) =
  163.       (* normal case *)
  164.       if index = Array.length a then
  165.     (fix mark;
  166.      read mark)
  167.       else  
  168.         a sub index
  169.           handle Subscript => raise Log
  170.  
  171.  
  172.   fun write(MARK(ref(SEG(ref(LISTSEG(ref nil,_)))),_)) x =
  173.       (* mark is at end of log. *)
  174.          raise Log
  175.     | write(mark as MARK(ref(seg as SEG(ref(LISTSEG _))),_)) x =
  176.       (* mark is in non-empty top LISTSEG; normalize first *)
  177.         (normalize seg;
  178.      write mark x)
  179.     | write(mark as MARK(ref(SEG(ref(ARRSEG(a,_)))),ref index)) x =
  180.       (* normal case *)
  181.         if index = Array.length a then
  182.       (fix mark;
  183.        write mark x)
  184.         else
  185.       update(a,index,x)
  186.             handle Subscript => raise Log
  187.  
  188.  
  189.   fun advance(mark as MARK(ref(SEG(ref(ARRSEG(a,_)))),indexref as ref index)) =
  190.     let val alen = Array.length a
  191.     in if index = alen then
  192.          (fix mark;
  193.           advance mark)
  194.        else if index < alen then 
  195.            inc indexref
  196.        else (* index > alen : invalid mark *)
  197.          raise Log
  198.         end
  199.    | advance(MARK(ref(SEG(ref(LISTSEG(ref nil,_)))),_)) = 
  200.         raise Log
  201.    | advance(mark as MARK(ref(seg as SEG(ref(LISTSEG _))),_)) =
  202.      (normalize seg;
  203.       advance mark)
  204.  
  205.   fun get mark = read mark before advance mark
  206.  
  207.   fun replace mark x = write mark x before advance mark
  208.  
  209.   fun equalMarks(mark1,mark2) =
  210.       let fun fixif (mark as MARK(ref(SEG(ref(ARRSEG(a,_)))),ref index)) =
  211.               if index = Array.length a then
  212.             fix mark
  213.         else ()
  214.         | fixif _ = ()
  215.       fun equal (MARK(ref seg1,ref index1), MARK(ref seg2,ref index2)) =
  216.           seg1 = seg2 andalso index1 = index2
  217.       in
  218.         fixif mark1;
  219.         fixif mark2;
  220.         equal (mark1,mark2)
  221.       end
  222. end
  223.  
  224.  
  225.  
  226.